home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
The World of Computer Software.iso
/
tcsel003.zip
/
DIRDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-16
|
7KB
|
237 lines
{ DIRDEMO.PAS
Author: Trevor Carlsen. Released into the public domain 1989
Last modification 1992.
Demonstrates in a very simple way how to display a directory in a screen
window and scroll backwards or forwards. }
uses
dos,
crt,
keyinput;
type
str3 = string[3];
str6 = string[6];
str16 = string[16];
stype = (_name,_ext,_date,_size);
DirRec = record
name : NameStr;
ext : ExtStr;
size : str6;
date : str16;
Lsize,
Ldate : longint;
dir : boolean;
end;
const
maxdir = 1000; { maximum number of directory entries }
months : array[1..12] of str3 =
('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
WinX1 = 14; WinX2 = 1;
WinY1 = 65; WinY2 = 23;
LtGrayOnBlue = $17;
BlueOnLtGray = $71;
page = 22;
maxlines : word = page;
type
DataArr = array[1..maxdir] of DirRec;
var
DirEntry : DataArr;
x, numb : integer;
path : DirStr;
key : byte;
finished : boolean;
OldAttr : byte;
procedure quicksort(var s; left,right : word; SortType: stype);
var
data : DataArr absolute s;
pivotStr,
tempStr : string;
pivotLong,
tempLong : longint;
lower,
upper,
middle : word;
procedure swap(var a,b);
var x : DirRec absolute a;
y : DirRec absolute b;
t : DirRec;
begin
t := x;
x := y;
y := t;
end;
begin
lower := left;
upper := right;
middle:= (left + right) div 2;
case SortType of
_name: pivotStr := data[middle].name;
_ext : pivotStr := data[middle].ext;
_size: pivotLong := data[middle].Lsize;
_date: pivotLong := data[middle].Ldate;
end; { case SortType }
repeat
case SortType of
_name: begin
while data[lower].name < pivotStr do inc(lower);
while pivotStr < data[upper].name do dec(upper);
end;
_ext : begin
while data[lower].ext < pivotStr do inc(lower);
while pivotStr < data[upper].ext do dec(upper);
end;
_size: begin
while data[lower].Lsize < pivotLong do inc(lower);
while pivotLong < data[upper].Lsize do dec(upper);
end;
_date: begin
while data[lower].Ldate < pivotLong do inc(lower);
while pivotLong < data[upper].Ldate do dec(upper);
end;
end; { case SortType }
if lower <= upper then begin
swap(data[lower],data[upper]);
inc(lower);
dec(upper);
end;
until lower > upper;
if left < upper then quicksort(data,left,upper,SortType);
if lower < right then quicksort(data,lower,right,SortType);
end; { quicksort }
function form(st : string; len : byte): string;
{ Replaces spaces in a numeric string with zeroes }
var
x : byte ;
begin
form := st;
for x := 1 to len do
if st[x] = ' ' then
form[x] := '0'
end;
procedure ReadDir(var count : integer);
{ Reads the current directory and places in the main array }
var
DirInfo : SearchRec;
procedure CreateRecord;
var
Dt : DateTime;
st : str6;
begin
with DirEntry[count] do begin
FSplit(DirInfo.name,path,name,ext); { Split file name up }
if ext[1] = '.' then { get rid of dot }
ext := copy(ext,2,3);
name[0] := #8; ext[0] := #3; { force to a set length for formatting }
Lsize := DirInfo.size;
Ldate := DirInfo.time;
str(DirInfo.size:6,size);
UnPackTime(DirInfo.time,Dt);
date := '';
str(Dt.day:2,st);
date := st + '-' + months[Dt.month] + '-';
str((Dt.year-1900):2,st);
date := date + st + #255#255;
str(Dt.hour:2,st);
date := date + st + ':';
str(Dt.Min:2,st);
date := date + st;
date := form(date,length(date));
dir := DirInfo.attr and Directory = Directory;
end; { with }
end; { CreateRecord }
begin { ReadDir }
count := 0; { for keeping a record of the number of entries read }
FillChar(DirEntry,sizeof(DirEntry),32); { initialize the array }
FindFirst('*.*',Anyfile,DirInfo);
while (DosError = 0) and (count < maxdir) do begin
inc(count);
CreateRecord;
FindNext(DirInfo);
end; { while }
if count < page then
maxlines := count;
quicksort(DirEntry,1,count,_name);
end; { ReadDir }
procedure DisplayDirectory(n : integer);
var
x,y : integer;
begin
y := 1;
for x := n to n + maxlines do
with DirEntry[x] do begin
gotoxy(4,y);inc(y);
write(name,' ');
write(ext,' ');
if dir then write('<DIR>')
else write(' ');
write(size:8,date:18);
end; { with }
end; { DisplayDirectory }
begin { main }
Clrscr;
gotoXY(5,24);
OldAttr := TextAttr;
TextAttr := BlueOnLtGray;
write(' F1=Sort by name F2=Sort by extension F3=Sort by size F4=Sort by date ');
gotoXY(5,25);
write(' Use arrow keys to scroll through directory display - <ESC> quits ');
TextAttr := LtGrayOnBlue;
window(WinX1,WinX2,WinY1,WinY2); { make the window }
Clrscr;
HiddenCursor;
ReadDir(numb);
x := 1; finished := false;
repeat
DisplayDirectory(x); { display maxlines files }
case KeyWord of
F1 {name} : begin
x := 1;
quicksort(DirEntry,1,numb,_name);
end;
F2 {ext} : begin
x := 1;
quicksort(DirEntry,1,numb,_ext);
end;
F3 {size} : begin
x := 1;
quicksort(DirEntry,1,numb,_size);
end;
F4 {date} : begin
x := 1;
quicksort(DirEntry,1,numb,_date);
end;
home : x := 1;
EndKey : x := numb - maxlines;
UpArrow : if x > 1 then
dec(x);
DownArrow : if x < (numb - maxlines) then
inc(x);
PageDn : if (x + page) > (numb - maxlines) then
x := numb - maxlines
else inc(x,page);
PageUp : if (x - page) > 0 then
dec(x,page)
else x := 1;
escape : finished := true
end; { case }
until finished;
NormalCursor;
TextAttr := OldAttr;
ClrScr;
end.